;; Visualization of a 2D Delaunay triangulation
;; Copyright (C) 2022  Rocks Mazama
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(ns mazama.compgeom.delaunay.bowyer-watson.visual
  (:require
   [cljfx.api :as fx]
   [mazama.compgeom.delaunay.bowyer-watson
    :refer [delaunay-begin delaunay-increment delaunay-end]])
  (:import
   [javafx.application Platform]
   [javafx.scene.paint Color]))

(def *the-model (atom {:stage-width 640 :stage-height 480}))

(defn- lerp [x0 y0 x1 y1 x]
  (let [w (/ (- y1 y0) (- x1 x0))]
    (+ y0 (* w (- x x0)))))

(defn- read-number [s]
  (clojure.edn/read-string s))

(defn- read-node-line [line]
  (let [[_ x y] (clojure.string/split line #"\s+")]
    (vector (read-number x) (read-number y))))

(defn- ignore? [line]
  (or (empty? line)
      (clojure.string/starts-with? line "#")))

(defn- normalize [file]
  (if (.endsWith file ".gz")
    (-> file
        clojure.java.io/input-stream
        java.util.zip.GZIPInputStream.)
    file))

(defn- read-node-file
  "Read a node file and return a sequence of 2D points.
  https://www.cs.cmu.edu/~quake/triangle.node.html"
  [file]
  (with-open [rdr (-> file normalize clojure.java.io/reader)]
    (->> (line-seq rdr)
         (map clojure.string/triml)
         (filter (complement ignore?))
         (drop 1)
         (map read-node-line)
         vec)))

(defn- bounds-reducer [[x-min x-max y-min y-max] [x y]]
  (vector (min x-min x)
          (max x-max x)
          (min y-min y)
          (max y-max y)))

(defn- bounds [S]
  (when (seq S)
    (let [val [##Inf, ##-Inf, ##Inf, ##-Inf]]
      (reduce bounds-reducer val S))))

(defn- update-model [file-name]
  (let [S (read-node-file file-name)
        pause (lerp 10 200 10000 10 (count S))]
    (when-let [[mesh T] (delaunay-begin S)]
      (swap! *the-model assoc :title file-name :points S :data-bounds (bounds S) :mesh mesh)
      (Thread/sleep 1000)
      (loop [T (seq T)
             mesh mesh]
        (when T
          (let [mesh (delaunay-increment mesh (first T))]
            (swap! *the-model assoc :mesh mesh)
            (Thread/sleep pause)
            (recur (next T) mesh))))
      (Thread/sleep 1000))))

(defn- transform [length x0 x1 x]
  (let [margin 5
        y0 margin
        y1 (- length margin)]
    (lerp x0 y0 x1 y1 x)))

(defn- edge-view [node-width node-height [x-min x-max y-min y-max] [[x0 y0] [x1 y1]]]
  {:fx/type :line
   :start-x (transform node-width x-min x-max x0)
   :start-y (transform node-height y-min y-max y0)
   :end-x (transform node-width x-min x-max x1)
   :end-y (transform node-height y-min y-max y1)
   :stroke Color/RED})

(defn- point-view [node-width node-height [x-min x-max y-min y-max] [x y]]
  {:fx/type :circle
   :layout-x (transform node-width x-min x-max x)
   :layout-y (transform node-height y-min y-max y)
   :radius 1.5})

(defn- edges [mesh]
  (->> mesh 
       keys
       (filter (complement keyword?))
       (filter (fn [[[x0 y0] [x1 y1]]] (and x0 y0 x1 y1 (>= y1 y0))))))

(defn- content-node [points data-bounds mesh node]
  {:fx/type fx/ext-on-instance-lifecycle
   :on-created #(swap! *the-model assoc :node %)
   :desc {:fx/type :border-pane
          :center {:fx/type :group
                   :children (when node
                               (let [node-width (.getWidth node)
                                     node-height (.getHeight node)]
                                 [{:fx/type :group
                                   :children (map (partial point-view node-width node-height data-bounds) points)}
                                  {:fx/type :group
                                   :children (map (partial edge-view node-width node-height data-bounds) (edges mesh))}]))}}})

(defn- root [{:keys [title points data-bounds mesh stage-height stage-width node]}]
  {:fx/type :stage
   :showing true
   :title title
   :width stage-width
   :height stage-height          
   :on-width-changed  #(swap! *the-model assoc :stage-width %)
   :on-height-changed #(swap! *the-model assoc :stage-height %)
   :scene {:fx/type :scene
           :root (content-node points data-bounds mesh node)}})

(def renderer
  (fx/create-renderer
    :middleware (fx/wrap-map-desc assoc :fx/type root)))

(defn -main []
  (let [examples ["http://people.eecs.berkeley.edu/~jrs/input/tri.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/4.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/box.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/spiral.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/flag.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/grid.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/dots.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/ladder.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/633.node"
                  "http://people.eecs.berkeley.edu/~jrs/input/ttimeu10000.node.gz"]]
    (-> (Thread. #(doseq [node-file examples] (update-model node-file))) .start))
  (Platform/setImplicitExit true)
  (fx/mount-renderer *the-model renderer))
